home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / gnu / emacs / emacs1857 / bin_d2.zoo / lisp / texinfmt.el < prev    next >
Lisp/Scheme  |  1991-12-02  |  42KB  |  1,210 lines
  1. ;; Convert texinfo files to info files.
  2. ;; Copyright (C) 1985, 1986, 1988 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 1, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;; GNU General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20.  
  21. (defvar texinfo-format-syntax-table nil)
  22.  
  23. (defvar texinfo-vindex)
  24. (defvar texinfo-findex)
  25. (defvar texinfo-cindex)
  26. (defvar texinfo-pindex)
  27. (defvar texinfo-tindex)
  28. (defvar texinfo-kindex)
  29. (defvar texinfo-last-node)
  30. (defvar texinfo-node-names)
  31.  
  32. (if texinfo-format-syntax-table
  33.     nil
  34.   (setq texinfo-format-syntax-table (make-syntax-table))
  35.   (modify-syntax-entry ?\" " " texinfo-format-syntax-table)
  36.   (modify-syntax-entry ?\\ " " texinfo-format-syntax-table)
  37.   (modify-syntax-entry ?@ "\\" texinfo-format-syntax-table)
  38.   (modify-syntax-entry ?\^q "\\" texinfo-format-syntax-table)
  39.   (modify-syntax-entry ?\[ "." texinfo-format-syntax-table)
  40.   (modify-syntax-entry ?\] "." texinfo-format-syntax-table)
  41.   (modify-syntax-entry ?\( "." texinfo-format-syntax-table)
  42.   (modify-syntax-entry ?\) "." texinfo-format-syntax-table)
  43.   (modify-syntax-entry ?{ "(}" texinfo-format-syntax-table)
  44.   (modify-syntax-entry ?} "){" texinfo-format-syntax-table)
  45.   (modify-syntax-entry ?\' "." texinfo-format-syntax-table))
  46.  
  47. (defun texinfo-format-buffer (&optional notagify)
  48.   "Process the current buffer as texinfo code, into an Info file.
  49. The Info file output is generated in a buffer visiting the Info file
  50. names specified in the @setfilename command.
  51.  
  52. Non-nil argument (prefix, if interactive) means don't make tag table
  53. and don't split the file if large.  You can use Info-tagify and
  54. Info-split to do these manually."
  55.   (interactive "P")
  56.   (let ((lastmessage "Formatting Info file..."))
  57.     (message lastmessage)
  58.     (texinfo-format-buffer-1)
  59.     (if notagify
  60.     nil
  61.       (if (> (buffer-size) 30000)
  62.       (progn
  63.         (message (setq lastmessage "Making tags table for Info file..."))
  64.         (Info-tagify)))
  65.       (if (> (buffer-size) 100000)
  66.       (progn
  67.         (message (setq lastmessage "Splitting Info file..."))
  68.         (Info-split))))
  69.     (message (concat lastmessage
  70.              (if (interactive-p) "done.  Now save it." "done.")))))
  71.  
  72. (defun texinfo-format-buffer-1 ()
  73.   (let (texinfo-format-filename
  74.     texinfo-example-start
  75.     texinfo-command-start
  76.     texinfo-command-end
  77.     texinfo-command-name
  78.     texinfo-last-node
  79.     texinfo-vindex
  80.     texinfo-findex
  81.     texinfo-cindex
  82.     texinfo-pindex
  83.     texinfo-tindex
  84.     texinfo-kindex
  85.     texinfo-stack
  86.     texinfo-node-names
  87.     outfile
  88.     (fill-column fill-column)
  89.     (input-buffer (current-buffer))
  90.     (input-directory default-directory))
  91.     (save-excursion
  92.       (goto-char (point-min))
  93.       (search-forward "@setfilename")
  94.       (setq texinfo-command-end (point))
  95.       (setq outfile (texinfo-parse-line-arg)))
  96.     (find-file outfile)
  97.     (texinfo-mode)
  98.     (set-syntax-table texinfo-format-syntax-table)
  99.     (erase-buffer)
  100.     (insert-buffer-substring input-buffer)
  101.     (goto-char (point-min))
  102.     (search-forward "@setfilename")
  103.     (beginning-of-line)
  104.     (delete-region (point-min) (point))
  105.     ;; Remove @bye at end of file, if it is there.
  106.     (goto-char (point-max))
  107.     (if (search-backward "@bye" nil t)
  108.     (delete-region (point) (point-max)))
  109.     ;; Make sure buffer ends in a newline.
  110.     (or (= (preceding-char) ?\n)
  111.     (insert "\n"))
  112.     ;; Scan the whole buffer, converting to Info format.
  113.     (texinfo-format-scan)
  114.     ;; Return data for indices.
  115.     (goto-char (point-min))
  116.     (list outfile
  117.       texinfo-vindex texinfo-findex texinfo-cindex
  118.       texinfo-pindex texinfo-tindex texinfo-kindex)))
  119.  
  120. (defvar texinfo-region-buffer-name "*Info Region*"
  121.   "*Name of the temporary buffer used by \\[texinfo-format-region].")
  122.  
  123. (defun texinfo-format-region (region-beginning region-ending)
  124.   "Convert the the current region of the Texinfo file to Info format.
  125. This lets you see what that part of the file will look like in Info.
  126. The command is bound to \\[texinfo-format-region].  The text that is
  127. converted to Info is stored in a temporary buffer."
  128.   (interactive "r")
  129.   (message "Converting region to Info format...")
  130.   (let (texinfo-command-start
  131.     texinfo-command-end
  132.     texinfo-command-name
  133.     texinfo-vindex
  134.     texinfo-findex
  135.     texinfo-cindex
  136.     texinfo-pindex
  137.     texinfo-tindex
  138.     texinfo-kindex
  139.     texinfo-stack
  140.     texinfo-format-filename
  141.     texinfo-example-start
  142.     texinfo-last-node
  143.     texinfo-node-names
  144.     (fill-column fill-column)
  145.     (input-buffer (current-buffer))
  146.     (input-directory default-directory)
  147.     filename-beginning
  148.     filename-ending)
  149.  
  150. ;;; Find a buffer to use.
  151.  
  152.     (switch-to-buffer (get-buffer-create texinfo-region-buffer-name))
  153.  
  154.     ;; Insert the region into the buffer.
  155.     (erase-buffer)
  156.  
  157.     (save-excursion
  158.       (set-buffer input-buffer)
  159.       (save-excursion
  160.     (save-restriction
  161.       (widen)
  162.       (goto-char (point-min))
  163.       ;; Initialize the buffer with the filename
  164.       ;; or else explain that a filename is needed.
  165.       (or (search-forward "@setfilename"
  166.                   (save-excursion (forward-line 100) (point)) t)
  167.           (error "The texinfo file needs a line saying: @setfilename <name>"))
  168.       (beginning-of-line)
  169.       (setq filename-beginning (point))
  170.       (forward-line 1)
  171.       (setq filename-ending (point)))))
  172.  
  173.     ;; Insert the @setfilename line into the buffer.
  174.     (insert-buffer-substring input-buffer
  175.                  (min filename-beginning region-beginning)  
  176.                  filename-ending)
  177.     
  178.     ;; Insert the region into the buffer.
  179.     (insert-buffer-substring input-buffer
  180.                  (max region-beginning filename-ending)
  181.                  region-ending)
  182.  
  183.     (texinfo-mode)
  184.  
  185.     ;; Install a syntax table useful for scanning command operands.
  186.     (set-syntax-table texinfo-format-syntax-table)
  187.     
  188.     ;; If the region includes the effective end of the data,
  189.     ;; discard everything after that.
  190.     (goto-char (point-max))
  191.     (if (re-search-backward "^@bye" nil t)
  192.     (delete-region (point) (point-max)))
  193.     ;; Make sure buffer ends in a newline.
  194.     (or (= (preceding-char) ?\n)
  195.     (insert "\n"))
  196.  
  197.     ;; Now convert for real.
  198.     (goto-char (point-min))
  199.     (texinfo-format-scan)
  200.     (goto-char (point-min)))
  201.  
  202.   (message "Done."))
  203.  
  204. ;; Perform those texinfo-to-info conversions that apply to the whole input
  205. ;; uniformly.
  206. (defun texinfo-format-scan ()
  207.   ;; Convert left and right quotes to typewriter font quotes.
  208.   (goto-char (point-min))
  209.   (while (search-forward "``" nil t)
  210.     (replace-match "\""))
  211.   (goto-char (point-min))
  212.   (while (search-forward "''" nil t)
  213.     (replace-match "\""))
  214.   ;; Scan for @-commands.
  215.   (goto-char (point-min))
  216.   (while (search-forward "@" nil t)
  217.     (if (looking-at "[@{}'` *]")
  218.     ;; Handle a few special @-followed-by-one-char commands.
  219.     (if (= (following-char) ?*)
  220.         ;; @* has no effect, since we are not filling.
  221.         (delete-region (1- (point)) (1+ (point)))
  222.       ;; The other characters are simply quoted.  Delete the @.
  223.       (delete-char -1)
  224.       (forward-char 1))
  225.       ;; @ is followed by a command-word; find the end of the word.
  226.       (setq texinfo-command-start (1- (point)))
  227.       (if (= (char-syntax (following-char)) ?w)
  228.       (forward-word 1)
  229.     (forward-char 1))
  230.       (setq texinfo-command-end (point))
  231.       ;; Call the handler for this command.
  232.       (setq texinfo-command-name
  233.         (intern (buffer-substring (1+ texinfo-command-start)
  234.                       texinfo-command-end)))
  235.       (let ((cmd (get texinfo-command-name 'texinfo-format)))
  236.     (if cmd (funcall cmd)
  237.       (texinfo-unsupported)))))
  238.   (cond (texinfo-stack
  239.      (goto-char (nth 2 (car texinfo-stack)))
  240.      (error "Unterminated @%s" (car (car texinfo-stack))))))
  241.  
  242. (put 'begin 'texinfo-format 'texinfo-format-begin)
  243. (defun texinfo-format-begin ()
  244.   (texinfo-format-begin-end 'texinfo-format))
  245.  
  246. (put 'end 'texinfo-f